#light
namespace FSharp.WebTools
#nowarn "47" // self-reference

open System.Text
open System.CodeDom
open System.Reflection
open System.Collections.Generic
open System.Web
open System.Web.UI

open Microsoft.FSharp
open Microsoft.FSharp.Quotations
open Microsoft.FSharp.Quotations.Raw;

open FSharp.WebTools
open FSharp.WebTools.ClientLibrary
open FSharp.WebTools.Quotations
open FSharp.WebTools.ClientExpressions

type Type = System.Type
type String = System.String

(*-----------------------------------------------------------------------------------------------*)
module WebUtils = begin
(*-----------------------------------------------------------------------------------------------*) 

  // Utilit function - uses text writer for generating strings
  let useIntendedStringWriter f =
    let sb = new System.Text.StringBuilder() in
    let wr = new System.CodeDom.Compiler.IndentedTextWriter(new System.IO.StringWriter(sb)) in
    f wr;
    wr.Close();
    sb.ToString();

  let useStringWriter f =
    let sb = new System.Text.StringBuilder() in
    let wr = new System.IO.StringWriter(sb) in
    f (wr :> System.IO.TextWriter);
    wr.Close();
    sb.ToString();

  // Recursively traverse over all child controls
  let traverseChildControls (ctrl:#Control) f =
    let rec traverse (ctrl:Control) f = (
      let mutable r = [] in
      for c in ctrl.Controls do 
        let (bdeep, add) = f c
        if (bdeep) then 
          r <- r@(traverse c f); 
        r <- match add with | Some v -> v::r | None -> r;
      done; r; ) in
    traverse (ctrl :> Control) f;

  // Creates function that generates class using specified generator
  let generateClassCode (ty:Type) (generator:Type -> Quotations.ClassInfo) =
    (fun wr -> Generator.generateClassCode (generator ty) (Generator.createContext(wr)) |> ignore)
      
end;

(*-----------------------------------------------------------------------------------------------*)
module ClassQuot = 
(*-----------------------------------------------------------------------------------------------*)
// Resolves class information and quotations for the type - is more or less "project" independent
// with exception that base resolving works with NativeClientClass / ClientClass and such

  open Quotations

  let objType = (type obj)
  let compilationMappingAttr = (type CompilationMappingAttribute)
  let clientClsAttr = (type ClientSideAttribute)
  let nativeClientClsAttr = (type NativeClientSideAttribute)
  let mixedClientClsAttr = (type MixedSideAttribute)
  let mappingAttr = (type MappingAttribute)
  let clientIgnoredAttr = (type ClientIgnoredAttribute)
  
  // Utility pattern 
  let (|MethodCtor|MethodPropGet|MethodPropSet|MethodOrdinary|) = fun (m:MethodBase) -> 
    if (m.IsConstructor) then MethodCtor 
    elif (m.Name.StartsWith("get_")) then MethodPropGet (m.Name.Substring(4))
    elif (m.Name.StartsWith("set_")) then MethodPropSet (m.Name.Substring(4))
    else MethodOrdinary    
  
  /// Find quotations for specified member in the class
  let findMemberExpr (t:Type) (mi:MethodBase) =
    let nsNames = t.Namespace.Split(Array.create 1 '.') |> Array.to_list in
    let instAdd = if (Enum.test mi.Attributes MethodAttributes.Static) then 0 else 1 in
    let overrid = if ((Enum.test mi.Attributes MethodAttributes.HideBySig) && (Enum.test mi.Attributes MethodAttributes.Virtual)) then ".override" else ""
    let (metaName,alt) = 
      (match mi with
        | MethodCtor -> (sprintf "%s.new.%d" t.Name (mi.GetParameters().Length), "")
        | MethodPropGet n -> (sprintf "%s.%s.get.%d%s" t.Name n (mi.GetParameters().Length + instAdd) overrid, "")
        | MethodPropSet n -> (sprintf "%s.%s.set.%d%s" t.Name n (mi.GetParameters().Length + instAdd) overrid, "")
        | MethodOrdinary -> (sprintf "%s.%s.%d%s" t.Name mi.Name (mi.GetParameters().Length + instAdd) overrid, // tupled / not tupled
                             sprintf "%s.%s.2%s" t.Name mi.Name overrid) ) in    
    
    let modDef = TopDefnData.Create(t.Assembly, (nsNames, metaName), (fun _ -> assert(false)) ) in
    let modDef2 = TopDefnData.Create(t.Assembly, (nsNames, alt), (fun _ -> assert(false)) )in
    let genArgs = 
      Seq.concat([ mi.DeclaringType.GetGenericArguments() |> Array.to_seq |> Seq.map ( fun _ -> objType );
                   if (mi.MemberType = MemberTypes.Constructor) then Seq.empty else
                     (mi.GetGenericArguments() |> Array.to_seq |> Seq.map ( fun _ -> objType ) ); ]) |> Seq.to_list;
    let defn = ResolveTopDefinition (modDef, genArgs) in
    let defn = if defn = None then ResolveTopDefinition (modDef2, genArgs) else defn in
    
    match defn with
      | Some expr -> MkStdExpr expr;
      | None -> 
          let a = (type int*int).Assembly
          let t2 = a.GetType("Microsoft.FSharp.Quotations.Raw") in
          let m = t2.GetProperty("topEnvTable",  Enum.combine [System.Reflection.BindingFlags.Static; System.Reflection.BindingFlags.NonPublic] ) in
          let v = m.GetValue(null, Array.zero_create 0) in
          //let mmap = (v :?> HashMultiMap<(string list*string)*System.Reflection.Assembly, (unit list)*((int -> Type) -> Type)*((int -> Type) -> Expr)>);
          let mmap = (v :?> HashMultiMap<((string list*string)*string), (unit list)*((int -> Type) -> Type)*((int -> Type) -> Expr)>);
          let s = mmap.Fold (fun ((ns,n),_) v acc -> acc + "\n" + n) ""
          MkUnresolved()
        

  let (|MixedClass|_|) = fun (t:Type) ->
    match t.GetCustomAttributes(mixedClientClsAttr, false).Length with
      | 0 -> None
      | n -> Some(t);
  
  let (|ClientClass|_|) = fun (t:Type) ->
    let nativeNum = t.GetCustomAttributes(nativeClientClsAttr, false).Length in
    match t.GetCustomAttributes(clientClsAttr, false).Length with
      | n when n>0 && nativeNum=0 -> Some t;
      | _ -> None;
      
  let (|NativeClientClass|_|) = fun (t:Type) ->
    let attrs = t.GetCustomAttributes(nativeClientClsAttr, false) in
    match attrs.Length with
      | 0 -> None;
      | n -> Some ((attrs.[0] :?> NativeClientSideAttribute).NativeName);      
    
  // removes type argument number
  let getClassName (n:string) =
    let i = n.IndexOf('`');
    if (i = -1) then n else n.Substring(0, i)

  let rec findClientClass (t:Type) =
    match t with
      | null -> None;
      | MixedClass t -> Some (getClassName t.Name)
      | ClientClass c -> Some (getClassName c.Name);
      | NativeClientClass n -> Some n;
      | ot -> findClientClass ot.BaseType;

  let findClientBase (t:Type) =  
    findClientClass (t.BaseType)
    
  /// Generates class info using reflection and F# quotations
  /// cutoff parameter is function that is used for filtering what members
  /// should be converted (MemberInfo -> bool)
  let getClassFromType (t:Type) = 
    let base = findClientBase t in

    // fields (tricky - fields in F# are compiled into properties with 
    //  "[CompilationMapping(SourceLevelConstruct.Field)]" attribute)
    let fields = 
      t.GetProperties(Enum.combine [BindingFlags.DeclaredOnly; BindingFlags.Public; BindingFlags.NonPublic; BindingFlags.Instance; BindingFlags.Static]) 
        |> Array.to_list 
        |> List.filter ( fun prop -> 
            match ((prop.GetCustomAttributes(compilationMappingAttr, false)) |> Array.to_list) with
              | [a] -> (a :?> CompilationMappingAttribute).SourceConstruct = SourceLevelConstruct.Field
              | _ -> false )
        |> List.map ( fun (fld) ->
            let opts = if (Enum.test (fld.GetGetMethod().Attributes) MethodAttributes.Static) 
                         then FieldOptions.Static else FieldOptions.None in
            MkField(fld, opts, fld.Name, fld.PropertyType, None) ) in

    // methods - ignore property getters & setters (get_ / set_)
    let methods = 
      t.GetMethods(Enum.combine [BindingFlags.DeclaredOnly; BindingFlags.Public; BindingFlags.NonPublic; BindingFlags.Instance; BindingFlags.Static]) |> Array.to_list 
        |> List.filter ( fun meth -> (meth.Name.StartsWith("get_") || meth.Name.StartsWith("set_")) = false) 
        |> List.filter ( fun meth -> 
            meth.GetCustomAttributes(mappingAttr, false).Length = 0 &&
            meth.GetCustomAttributes(clientIgnoredAttr, false).Length = 0 )
        |> List.map ( fun (meth) ->
            let expr = (findMemberExpr t (meth :> MethodBase)) in
            let retType = if meth.ReturnType.FullName="System.Void" then None else (Some meth.ReturnType) in
            let opts = 
              if (Enum.test meth.Attributes MethodAttributes.Static) then MemberOptions.Static 
              elif (Enum.test meth.Attributes MethodAttributes.Abstract) then MemberOptions.Abstract 
              else MemberOptions.None 
            MkMethod(meth, opts, meth.Name, expr, retType) ) 
      
    // properties - ignore properties with "[CompilationMapping(SourceLevelConstruct.Field)]" attribute
    // (this properties are generated for fields by F#)
    let props = 
      t.GetProperties(Enum.combine [BindingFlags.DeclaredOnly; BindingFlags.Public; BindingFlags.NonPublic; BindingFlags.Instance; BindingFlags.Static]) |> Array.to_list 
        |> List.filter ( fun prop -> (prop.GetCustomAttributes(compilationMappingAttr, false)).Length = 0 )
        |> List.filter ( fun prop -> 
            prop.GetCustomAttributes(mappingAttr, false).Length = 0 &&
            prop.GetCustomAttributes(clientIgnoredAttr, false).Length = 0 )
        |> List.map ( fun (prop) -> 
            let findPropExpr mi = if (mi = null) then None else Some (findMemberExpr t (mi :> MethodBase)) in
            let getExp = findPropExpr (prop.GetGetMethod()) in
            let setExp = findPropExpr (prop.GetSetMethod()) in
            let typ = prop.PropertyType in
            let opts = if (ClientExpressions.isPropStatic prop) 
                         then MemberOptions.Static else MemberOptions.None in
            MkProperty (prop, opts, prop.Name, getExp, setExp, typ) ) in

    // constructors
    let ctors = 
      t.GetConstructors() 
      |> Array.to_list 
        |> List.filter ( fun meth -> 
            meth.GetCustomAttributes(mappingAttr, false).Length = 0 &&
            meth.GetCustomAttributes(clientIgnoredAttr, false).Length = 0 )
      |> List.map ( fun (ctor) ->
          let expr = (findMemberExpr t (ctor :> MethodBase)) in MkConstructor(ctor, expr) ) in
    
    // combine all members  
    MkClassInfo (getClassName t.Name) (base) (ctors@fields@methods@props)

  /// Returns inheritance tree for the client-side
  let rec getClientClassHierarchy (t:Type) = 
    match t with
      | null -> [];
      | ClientClass t -> t::(getClientClassHierarchy (t.BaseType));
      | ot -> getClientClassHierarchy (ot.BaseType);          


(*-----------------------------------------------------------------------------------------------*)
module ClientClassQuot = 
(*-----------------------------------------------------------------------------------------------*)

  let webBehaviorAttr = (type WebBehaviorAttribute)
  let webMappingAttr = (type WebMappingAttribute)

  let rec (|AnyClientControl|_|) (t:Type) =
    if (not (t.GetInterfaces() |> Array.exists ((=) (type IClientControl)))) then None
    elif (not ((type Control).IsAssignableFrom(t))) then None
    else Some(t)

  let testClientConstructor (mi:MemberInfo) = 
    let isBeh (a:obj) beh = ((a :?> WebBehaviorAttribute).Behavior &&& beh) = beh
    match (mi.GetCustomAttributes(webBehaviorAttr, true) |> Array.to_list) with
    | [attr] when isBeh attr WebBehavior.ClientConstructor -> true
    | _ -> false
    
  /// Translate members with
  ///   [<WebBehavior(WebBehavior.ClientConstructor)>]
  /// to actual constructors
  let transformClientConstructors (c:ClassInfo) =
    let ctors, others = 
      c.Members |> List.partition (fun m -> 
        match m with | Method(mi,_,_,_,_) -> testClientConstructor mi | _ -> false )
    let nctors = 
      ctors |> List.map ( fun ct -> 
        match ct with | Method(meth, opts, name, expr, ty) -> MkConstructor(meth, expr) | _ -> assert(false) )
    MkClassInfo c.Name c.BaseName (nctors@others)
        

  /// Postprocessing for mixed classes -
  /// * adds field "__mixed_fields__" which contains list of mixed fields
  /// * adds field "__js_class__" which contains class name        
  let postprocMixedClass (all:bool) (t:Type) (c:ClassInfo) =
    // postprocessing of the class
    let flds = c.Members |> Generator.membersMapFilter (|Field|_|)
    let flds = 
      // all specifies if we should take all members or those that are Duplex
      if all then 
        flds |> List.map (fun (_, _, name, _, _) -> name) 
      else
        flds |> Utils.map_filter (fun (mi, _, name, _, _) -> 
          match (mi :?> PropertyInfo).PropertyType with
          | AnyClientControl _ -> Some(name)
          | _ when (mi.GetCustomAttributes((type DuplexFieldAttribute), false).Length > 0) -> Some(name)
          | _ -> None ) 
            
    let lstr = "[" + (Utils.fold_sep (fun e st -> st + "'" + e + "'") (fun st -> st + ", ") flds "") + "]"
    let jsn = "\"" + (Utils.encode (Utils.getGenericTypeDef t).AssemblyQualifiedName) + "\""
    let mix = MkField(null, FieldOptions.None, "__mixed_fields__", (type string[]), Some(MkEmbeddedExpr(lstr)))
    let cnf = MkField(null, FieldOptions.None, "__js_class__", (type string), Some(MkEmbeddedExpr(jsn)))
    MkClassInfo c.Name c.BaseName (cnf::mix::c.Members)          
    
    
  let (|CastToMemberInfo|) (mi:#MemberInfo) = (mi :> MemberInfo)

  /// Filter members using member info   
  let filterMembers f (c:ClassInfo) =    
  
    let propType (mi:MemberInfo) =
      if mi = null then None else Some((mi :?> PropertyInfo).PropertyType)
    let methType (mi:MemberInfo) =
      if mi = null then None else Some((mi :?> MethodInfo).ReturnType)
      
    let nmembs = 
      c.Members |> List.filter (fun m ->
        match m with
        | Constructor(mi, _) -> f mi None
        | Field(mi, _, _, _, _) -> f mi None
        | Property(mi, _, _, _, _, _) -> f mi (propType mi)
        | Method(mi, _, _, _, _) -> f mi (methType mi)
        | _ -> assert(false); )
    MkClassInfo c.Name c.BaseName nmembs

  let filterClientPartial (mi:MemberInfo) (optty:Type option)= 
    let isBeh (a:obj) beh = 
      ((a :?> WebBehaviorAttribute).Behavior &&& beh) = beh
    if (mi = null) then 
      true
    else
      let wat = mi.GetCustomAttributes(webBehaviorAttr, true) |> Array.to_list
      let dat = mi.GetCustomAttributes((type DuplexFieldAttribute), true) |> Array.to_list
      match (wat,dat,optty) with
      | [attr],_,_ when isBeh attr WebBehavior.ClientSide -> true
      | _, [a],_ -> true
      | _, _, Some(t) when ClientExpressions.isClientType t -> true
      | _ -> false
      
  /// Generates class - with no filtering
  let getClassFromClientType (t:Type) = 
  
    // client class type?
    let clattrs = t.GetCustomAttributes((type ClientSideAttribute), false)
    let isExternal = t.GetCustomAttributes((type ExternalTypeAttribute), false).Length > 0
    let (|NoClient|PartialClient|FullSerializableClient|FullClient|) (clattrs:obj[]) =
      if (clattrs.Length = 0) then NoClient
      elif ((clattrs.[0] :? NeutralSideAttribute) || isExternal) then FullSerializableClient
      elif (clattrs.[0] :? MixedSideAttribute) then PartialClient
      else FullClient
      
    // generate proper client side class / report error
    match clattrs with 
    | FullClient ->
        ClassQuot.getClassFromType t  
        
    | FullSerializableClient ->
        ClassQuot.getClassFromType t
        |> postprocMixedClass true t
        
    | PartialClient ->    
        ClassQuot.getClassFromType t 
        |> postprocMixedClass false t
        |> filterMembers filterClientPartial
        |> transformClientConstructors
        
    | _ -> 
      failwith "Can't register non-client side class!"

  let processSingleCtor ty baseFunc memb =
    match memb with 
    | Constructor(um, StdExpr(Lambdas(vars, body))) ->
        let (thisRef, vars, body) = Generator.prepareMemberLambda (vars, MkStdExpr body)
        let basecall = baseFunc ty vars
        let nbody = MkExtSeqExpr([basecall; body])
        MkConstructor(null, MkExtLambda(vars, nbody))
    | _ -> failwith "Expected constructor"

  /// Constructor postprocessing
  /// * add default constructor 'def' if no default ctor is available
  /// * add proper base call to all constructors
  let processConstrucotrs (ty:Type) def baseFunc (c:ClassInfo) =      
    let (ctors,membs) = c.Members |> List.partition ((|Constructor|_|) >> Option.is_some)
    let ctors = if (ctors.Length = 0) then def::ctors else ctors
    MkClassInfo c.Name c.BaseName ((ctors |> List.map (processSingleCtor ty baseFunc))@membs)


  // utils for the next function
  let getControlID (c:#System.Web.UI.Control) =
    let id = c.ID // ASP.NET sometimes doesn't assign ID, but we can get it from CLientID
    if (id <> null && id <> "") then id 
    elif (c.Parent <> null) then 
      let pl = c.Parent.ClientID.Length
      c.ClientID.Substring(pl+1, c.ClientID.Length-pl-1)
    else
      ""
    
  let testAttrs (prop:PropertyInfo) = 
    match Array.to_list(prop.GetCustomAttributes((type Core.CompilationMappingAttribute), true)) with
      | [] -> None;
      | a::_ -> if ((a :?> Core.CompilationMappingAttribute).SourceConstruct = SourceLevelConstruct.Field) then Some prop else None;
      
  let testPropClient this (prop:PropertyInfo) = 
    match prop.PropertyType with
      | AnyClientControl c -> 
          let value = prop.GetValue(this, Array.zero_create 0)
          let ctrl = if (value = null) then None else Some (value :?> IClientControl)
          Some (prop, ctrl)
      | _ -> None;
    
  // find controls with according fields    
  let findClientControlFields this (t:Type) initGenerator = 
    let regCtrls = new Dictionary<IClientControl, string>();
    let (nullFields, flds) = 
         t.GetProperties() 
      |> Array.to_list  
      |> Utils.map_filter testAttrs
      |> Utils.map_filter (testPropClient this)
      |> Utils.fmap ( fun env (prop, ctl) -> 
            // create field with initialization code
            let clientTy = match (ClassQuot.findClientClass prop.PropertyType) with Some(s) -> s | None -> failwith "IClientControl doesn't have any client class in hierarchy!"
            let init = 
              match ctl with 
                | Some c ->
                    let wctl = ((box c) :?> Control)
                    regCtrls.Add(c, prop.Name);
                    MkEmbeddedExpr("this." + prop.Name + " = " + (initGenerator clientTy (getControlID wctl) wctl.ClientID))
                | _ -> 
                    MkEmbeddedExpr("this." + prop.Name + " = " + (initGenerator clientTy prop.Name prop.Name))
            
            // also collect all fields with null value (these are only client-side)
            let nullFields = match ctl with | Some c -> env | None -> (prop.PropertyType, prop.Name)::env
            let fld = (MkField(prop, FieldOptions.None, prop.Name,prop.PropertyType, None), (init));
            nullFields, fld ) []
    (nullFields, regCtrls, flds)
            
  /// GUI stuff handling
  /// * add field for every client-side control that has a field
  /// * get list of all other controls that were created declaratively
  /// * add code to initialize all controls using 'CreateElement'
  ///   (as a OnClientIniti function)
  /// * returns controls that need to be processed - register the type, find fields ...
  let addControlFieldsAndInitializers (this:#Control) t (c:ClassInfo) =     
    
    let initPg  typ id clid = "CreateElement(new " + typ + "(), [$get('" + clid + "')])"
    let initCtl typ id clid = "CreateElement(new " + typ + "(), [$get(el.id + '_" + id + "')])"
    let initializer = if ((type Page).IsAssignableFrom(this.GetType())) then initPg else initCtl
    
    // controls with fields
    let (nullFields, regCtrls, flds) = findClientControlFields this t initializer

    // register unnamed controls .. 
    // finds all controls in the this.Controls collection that implement IClientControl
    // we don't want to traverse subtree of client controls, so we return false..
    let testClientControl (ctl:Control) =
      match (box ctl) with 
        | :? IClientControl as cc -> false, Some ctl 
        | _ -> true, None             
               
    // if the control is named than generate "controls.Add(name)" else generate "CreateElement" to initialize the control
    let getInitializationCode (cc:Control) =
      let ct = ((box cc) :?> IClientControl)
      if (regCtrls.ContainsKey(ct)) 
        then "this.Controls.Add(this." + regCtrls.[ct] + ")"
        else 
          let cts = match (ClassQuot.findClientClass (ct.GetType())) with 
                      | Some(s) -> s 
                      | None -> failwith "IClientControl doesn't have any client class in hierarchy!"
          "this.Controls.Add(" + (initializer cts (getControlID cc) cc.ClientID) + ")"
    
    let getInitializationCodeForNullField (t:Type, s:string) = 
      "this.Controls.Add(this." + s + ")"
      
    // all controls including those without fields
    let ctrls = WebUtils.traverseChildControls this testClientControl
    let exprs =   
      (ctrls |> List.map (getInitializationCode >> MkEmbeddedExpr))@
      (nullFields |> List.map (getInitializationCodeForNullField >> MkEmbeddedExpr))
      
    // initialization      
    let varel = MkEmbeddedExpr("var el = this.el"); // so we can use [el] everywhere
    let body = MkExtLambda([ExprVar.Fresh("", (type unit))], MkExtSeqExpr (varel::exprs))
    let clmeth = MkMethod(null, MemberOptions.Overridden, "OnClientInitControls", body, None) 
   
    let ctors, membs = c.Members |> List.partition ((|Constructor|_|) >> Option.is_some)
    let inits = flds |> List.map snd
    let nctors = ctors |> List.map (fun c -> 
      match c with 
      | Constructor(ci, ScriptLambda(v, ebody)) ->          
          MkConstructor(ci, MkExtLambda(v, MkExtSeqExpr(ebody::inits)))
      | Constructor(ci, StdExpr(Lambdas(v, body))) ->          
          MkConstructor(ci, MkExtLambda(v, MkExtSeqExpr((MkStdExpr body)::inits)))
      | _ -> assert(false); )

    let flds = flds |> List.map fst
    (ctrls, MkClassInfo c.Name c.BaseName (clmeth::(nctors@membs@flds)))

  // Checks for unresolved members in the class
  let checkUnresolved (c:ClassInfo) =
    c.Members |> List.iter (fun m ->
      match m with
      | Constructor(CastToMemberInfo(mi), ScriptUnresolved(e)) -> 
          failwithf "Unresolved constructor in %A!" mi.DeclaringType.Name;
      | Field(CastToMemberInfo(mi), s, _, _, Some(ScriptUnresolved(e))) -> 
          failwithf "Unresolved field initializer: %A in %A" s mi.DeclaringType.Name;
      | Property(CastToMemberInfo(mi), _, s, Some(ScriptUnresolved(e)), _, _) -> 
          failwithf "Unresolved property getter: %A in %A" s mi.DeclaringType.Name;
      | Property(CastToMemberInfo(mi), _, s, _, Some(ScriptUnresolved(e)), _) -> 
          failwithf "Unresolved property setter: %A in %A" s mi.DeclaringType.Name;
      | Method(mi, opts, s, ScriptUnresolved(e), _) when not (Enum.test opts MemberOptions.Abstract) -> 
          failwithf "Unresolved method: %A in %A" s mi.DeclaringType.Name;
      | _ -> (); )
    c


(*-----------------------------------------------------------------------------------------------*)

/// Control that contains both server and client side code
[<NativeClientSide("Dom.Element")>]
type ClientControl = 
  inherit System.Web.UI.WebControls.WebControl as base  

  /// Constructor
  new () = { }

  interface IElement with  
    member this.ID 
      with get() = base.ID

    member this.ClientID 
      with get() = base.ClientID
      
(* WORKAROUND: for the 'convMethodRef' bug in F# 1.9.3          
    - renamed from 'Visible' *)
    member this.ClientVisible 
      with get() = base.Visible
      and set(v:bool) = base.Visible <- v

    member this.Position 
      with get() = (raise ClientSideScript)
      and set(v:Position) = (raise ClientSideScript:unit);

    member this.Size 
      with set(v:Size) = (raise ClientSideScript:unit);
    
    member this.AttachHandler(name, func) = (raise ClientSideScript:unit)

    member this.AppendChild (el:IElement) =
      (raise ClientSideScript:unit)

    member this.SetupDragDrop (el:IElement) = 
      (raise ClientSideScript:unit)
      
    member this.GetChild (s:string) =
      (raise ClientSideScript:IElement option)

    member this.InnerHtml 
      with get() = (raise ClientSideScript:string)
      and set(s:string) = (raise ClientSideScript:unit)

    member this.InnerText
      with get() = (raise ClientSideScript:string)
      and set(s:string) = (raise ClientSideScript:unit)

    member this.Value
      with get() = (raise ClientSideScript:string)
      and set(s:string) = (raise ClientSideScript:unit)
    
    member this.AddCssClass(s:string) =
      (raise ClientSideScript:unit)
    member this.RemoveCssClass(s:string) =
      (raise ClientSideScript:unit)
    
    member this.ClientClick =
      (raise ClientSideScript:ClientEvent)
    member this.ClientMouseUp =
      (raise ClientSideScript:ClientEvent)
    member this.ClientMouseDown =
      (raise ClientSideScript:ClientEvent)
    member this.ClientMouseMove =
      (raise ClientSideScript:ClientEvent)
    member this.ClientSelectStart =
      (raise ClientSideScript:ClientEvent)
  end;
  
(* WORKAROUND: for the 'convMethodRef' bug in F# 1.9.3          
    - renamed from 'Visible' *)
  member this.ClientVisible 
    with get() = base.Visible
    and set(v:bool) = base.Visible <- v
    
  member this.Position 
    with get() = (raise ClientSideScript:Position)
    and set(v:Position) = (raise ClientSideScript:unit);

  member this.Size 
    with set(v:Size) = (raise ClientSideScript:unit);
  
  member this.AttachHandler(name, func) = 
    (raise ClientSideScript:unit)
    
  member this.AppendChild (el:IElement) =
    (raise ClientSideScript:unit)

  member this.SetupDragDrop (el:IElement) = 
    (raise ClientSideScript:unit)
    
  member this.GetChild (s:string) =
    (raise ClientSideScript:IElement option)

  member this.InnerHtml 
    with get() = (raise ClientSideScript:string)
    and set(s:string) = (raise ClientSideScript:unit)

  member this.InnerText
    with get() = (raise ClientSideScript:string)
    and set(s:string) = (raise ClientSideScript:unit)

  member this.Value
    with get() = (raise ClientSideScript:string)
    and set(s:string) = (raise ClientSideScript:unit)
  
  member this.ClientClick =
    (raise ClientSideScript:ClientEvent)
  member this.ClientMouseUp =
    (raise ClientSideScript:ClientEvent)
  member this.ClientMouseDown =
    (raise ClientSideScript:ClientEvent)
  member this.ClientMouseMove =
    (raise ClientSideScript:ClientEvent)
  member this.ClientSelectStart =
    (raise ClientSideScript:ClientEvent)  

(*-----------------------------------------------------------------------------------------------*)

/// User-control with client-side stuff
[<NativeClientSide("Dom.Element")>]
type ClientUserControl() = 
  inherit System.Web.UI.UserControl() as base
  interface IClientControl
  
  override x.Render(wr) =
    wr.Write("<div id=\"{0}\">", x.ClientID)
    base.Render(wr)
    wr.Write("</div>")

(*-----------------------------------------------------------------------------------------------*)

/// Abstraction for response - represents the output for generating script code
/// (this is used by the testing framework to generate source as a string)
type IResponse = 
  abstract Write : string -> unit
  abstract End : unit -> unit
  abstract ContentType : string with set


/// Page with additional functionality for client-side scripts
/// Contains methods for generating client-side code from 
/// F# quotations
[<NativeClientSide("Dom.Page")>]
type ClientPage() as this = 
  inherit System.Web.UI.Page() as base

  let scripts = new Dictionary<String, String>()
  let response = 
    { new IResponse with 
        member x.Write s = this.Response.Write s
        member x.End() = this.Response.End ()
        member x.ContentType with set(v) = this.Response.ContentType <- v }
      
  interface IClientPage
  (******************************** Client-side scripts  *********************************)
  
  member this.RegisterScriptBlockOnce name funGenerate =
    if (not (scripts.ContainsKey(name))) then
      scripts.Add(name, ""); 
      let s = WebUtils.useIntendedStringWriter funGenerate
      scripts.Remove(name) |> ignore; 
      scripts.Add(name, s); 
  
  member this.GenerateScriptFile (resp : IResponse) =
    for sr in scripts do
      resp.Write("/* "^sr.Key^" */\n")
      resp.Write(sr.Value^"\n\n")
    resp.ContentType <- "text/plain" // TODO: text/javascript
    resp.End()
    
  member this.GenerateCoreScriptFile (resp) =
    scripts.Clear()
    this.RegisterClientClass(type Size)
    this.RegisterClientClass(type Position)
    this.RegisterClientClass(type Rectangle)
    this.RegisterClientClass(type Convert)
    this.RegisterClientClass(type EventArgs)
    this.RegisterClientClass(type CancelEventArgs)
    this.RegisterClientClass(type MouseEventArgs)
    this.RegisterClientClass(type Timer)
    this.RegisterClientClass(type LibXmlHttpRequest)
    this.RegisterClientClass(type JsonSerializer)
    this.RegisterClientClass(type JsonDeserializer)
    
    this.RegisterClientClass(type Async)
    this.RegisterClientClass(type AsyncMonad)
    
    this.RegisterClientClass(type Internal.StringJS)
    this.RegisterClientClass(type Internal.Int32)
    this.RegisterClientClass(type Internal.Double)    
    this.RegisterClientClass(type Internal.MathJS)
    this.RegisterClientClass(type Internal.Random)
    this.RegisterClientClass(type Internal.Tuple)
    this.RegisterClientClass(type Internal.TimeSpan)
    this.RegisterClientClass(type Internal.DateTime)
    this.RegisterClientClass(type Internal.StringBuilder)
    this.RegisterClientClass(type Internal.TextWriter) // this has to be in correct order determined by inheritance
    this.RegisterClientClass(type Internal.StringWriter)
    this.RegisterClientClass(type Internal.HtmlTextWriter)
    this.RegisterClientClass(type Internal.DiscriminatedUnion)    
    this.RegisterClientClass(type Internal.ResizeArray<obj>)    
    this.RegisterClientClass(type Internal.Stack<obj>)    
    this.RegisterClientClass(type Internal.ListModule)    
    this.RegisterClientClass(type Internal.PrintModule)    
    this.RegisterClientClass(type Internal.ArrayModule)    
    
    this.GenerateScriptFile(resp)
    
  member this.RegisterClassHierarchy (ty:Type) (str:string) (gen:Type -> Quotations.ClassInfo) =
    
    // doesn't find the right base class for control...
    // ... todo interfaces
    
    let types = ClassQuot.getClientClassHierarchy ty in
    types |> List.iter ( fun ty -> this.RegisterScriptBlockOnce (str^"-"^(ty.FullName)) (WebUtils.generateClassCode ty gen) );
    types.Length > 0;

  (******************************** Script generation  *********************************)

  /// Generate ordinary client class
  member this.getOrdinaryClass (t:Type) =
       ClientClassQuot.getClassFromClientType t
    |> ClientClassQuot.checkUnresolved
    
  /// Generate client class from page
  member this.getWebElementClass isControl (ctrl:Control) (t:Type) = 
  
    // depending on type we need different constructor
    let defCtor, baseCallFunc = 
      if isControl 
        then // TODO: verify ctor arguments & get variable name
          (MkConstructor(null, MkStdExpr(<@@ fun(el:ClientLibrary.IElement) -> (); @@>))),
          (fun ty vars -> MkEmbeddedExpr(t.Name + ".callBaseMethod(this, \"ctor\", [el])"))
        else 
          (MkConstructor(null, MkStdExpr(<@@ fun() -> (); @@>))),
          (fun ty vars -> MkEmbeddedExpr(t.Name + ".callBaseMethod(this, \"ctor\", [])"))

    let (unprocessedCtrls, cls) =
         ClientClassQuot.getClassFromClientType t
      |> ClientClassQuot.checkUnresolved
      |> ClientClassQuot.processConstrucotrs t defCtor baseCallFunc
      |> ClientClassQuot.addControlFieldsAndInitializers ctrl t    
      
    // we need only types and one (random) instance to add right fields etc..
    let uniqeByType = new Dictionary<Type,Control>()
    unprocessedCtrls |> List.iter (fun c -> 
      let t = c.GetType()
      if (not (uniqeByType.ContainsKey(t))) then uniqeByType.Add(c.GetType(), c))
    uniqeByType |> Seq.iter (fun kvp -> this.RegisterControlType kvp.Key kvp.Value)
    cls
        
  (******************************** Remote calls  *********************************)

  member this.InvokeRemoteCall () =
    this.Response.Clear();
    
    try
      let ca = this.Request.QueryString.get_Item("invoke").Split([| '|' |])
      if (ca.Length <> 2) then failwith "Invalid http request";
      let ty = Type.GetType(ca.[0]);
      
      use sr = new System.IO.StreamReader(this.Request.InputStream)
      let serArgs = sr.ReadToEnd()
      
      let meth = ty.GetMethod(ca.[1]);
      let expectedTypes = meth.GetParameters() |> Array.map (fun p -> p.ParameterType)
      let expectedInst = if (meth.IsStatic) then None else Some(meth.DeclaringType)
      let (inst,args) = Serializer.deserialize this (expectedInst,expectedTypes) serArgs;
      let v = meth.Invoke(inst, args) 
      
      Serializer.serialize v this.Response.Output; 
    with e ->
      this.Response.Write(e.ToString().Replace("\"", "\\\""))
      this.Response.StatusCode <- 500
    this.Response.End();
  
  (******************************** ASP.NET stuff  *********************************)
  
  member this.IsClearRequest 
    with get() = 
      (not this.IsPostBack) && (this.Request.QueryString.get_Item("scriptcmd") = null)
    
  /// Returns current client page
  static member Current 
    with get() =
      (HttpContext.Current.Handler :?> ClientPage);
  
  /// Init
  override this.OnInit (e:System.EventArgs) =
    let createScript s = 
      let ctrl = new LiteralControl()
      ctrl.Text <- "<script type=\"text/javascript\" src=\"" + s + "\"></script>"
      (ctrl :> Control)
    this.Header.Controls.Add(createScript "fswebtools.axd?id=atlas")
    this.Header.Controls.Add(createScript "fswebtools.axd?id=core")
    base.OnInit (e);
  
  member this.GeneratePageScript(generateJs, resp) =
    let ctrl = (this :> Control)
    if (this.RegisterClassHierarchy (this.GetType()) "RegisterPage" (this.getWebElementClass false ctrl)) then
      let typ = List.hd (ClassQuot.getClientClassHierarchy (this.GetType())) 
      let js = String.Format("var thisPage = CreatePage(new {0}(), []);\n", typ.Name) 
      this.Page.ClientScript.RegisterStartupScript (this.GetType(), System.Guid.NewGuid().ToString(), js, true)
  
    if (generateJs) then 
        this.GenerateScriptFile(resp)
            
  override this.OnLoad (e:System.EventArgs) =
    if (this.Request.QueryString.get_Item("scriptcmd") = "http-call") then 
      this.InvokeRemoteCall();
      
    if (this.Request.QueryString.get_Item("scriptcmd") = "core-javascript") then 
      this.GenerateCoreScriptFile(response)
  
    this.GeneratePageScript(this.Request.QueryString.get_Item("scriptcmd") = "javascript", response)
      
    // Generate <script> tag in Head..
    let createScript cmd = (
      let ctrl = new System.Web.UI.HtmlControls.HtmlGenericControl("script") in
      ctrl.Attributes.Add("type", "text/javascript");
      let url = this.Request.Url.ToString() in
      let scriptUrl = url ^ (if (url.IndexOf('?') = -1) then "?" else "&") ^ "scriptcmd=" ^ cmd in
      ctrl.Attributes.Add("src", scriptUrl);    
      ctrl; ) in
    this.Header.Controls.Add(createScript "core-javascript");
    this.Header.Controls.Add(createScript "javascript");
    base.OnLoad(e);

  override this.OnPreRender(e) =
    let js = WebUtils.useStringWriter (Serializer.serializePageState (box this) (this.GetType()))
    let js = "function deserializePageState() {\n  JsonDeserializer.DeserializeServerResponse("+js+");\n}\n";
    this.Page.ClientScript.RegisterStartupScript(this.GetType(), "deserialize-duplex-fields", js, true);
    base.OnPreRender(e)
    
  /// Internal - registers raw function
  member this.RegisterRawFunction (name:string) (expr:Expr) =
    this.RegisterScriptBlockOnce ("RegisterRawFunction-"^name)  (fun wr ->
      Generator.generateFunctionCode name (MkStdExpr expr) false (Generator.createContext(wr)) |> ignore
      wr.WriteLine(); );

  /// Add class to client side code
  member this.RegisterClientClass (ty:Type) =
    let ty = Utils.getGenericTypeDef ty
    this.RegisterClassHierarchy ty "RegisterClientClass" this.getOrdinaryClass |> ignore
      
  /// Add client side control type to generated JS
  member this.RegisterControlType (ty:Type) (c:Control) =
    let ty = Utils.getGenericTypeDef ty
    this.RegisterClassHierarchy ty "RegisterClientControl" (this.getWebElementClass true c) |> ignore
    
(*-----------------------------------------------------------------------------------------------*)

open System.Resources

/// Http handler for serving core JavaScript scripts (compiled as resources)
type ScriptHandler() = 
  interface IHttpHandler with
    member x.IsReusable = true
    member x.ProcessRequest(ctx:HttpContext) =
      let writeFile =
        match ctx.Request.QueryString.Item("id") with
        | "core" -> Some("webres.resources", "web_jslib.js")
        | "atlas" -> Some("webres.resources", "web_jsatlas.js")
        | _ -> None
      match writeFile with
      | Some(res,file) ->
          ctx.Response.ContentType <- "text/javascript"
          let asm = Assembly.GetExecutingAssembly()
          use res = new ResourceReader(asm.GetManifestResourceStream(res))
          for (tup) in res do
            let tup = tup :?> System.Collections.DictionaryEntry
            if (unbox tup.Key = file) then
              ctx.Response.Write((unbox tup.Value) : string)
      | _ ->
          ctx.Response.Write("window.alert('Incorrect use of the fswebtools.axd script handler!');")